home *** CD-ROM | disk | FTP | other *** search
/ TPUG - Toronto PET Users Group / TPUG Users Group CD / TPUG Users Group CD.iso / C64 / T-TPUG Old Monthly Disks / (c)t3.d64 / mail.c (.txt) < prev    next >
Commodore BASIC  |  2007-02-04  |  8KB  |  333 lines
  1. 1 REM *****************
  2. 2 REM * MAIL.64  SUBMITTED BY
  3. 3 REM * AL JOHNSON & DAVE JOHNSON
  4. 4 REM * 2446 SOUTHGATE SQ
  5. 5 REM * RESTON, VA  22091
  6. 6 REM *****************
  7. 7 REM * LIST 11000-  FOR NOTES ON PROG
  8. 8 REM *****************
  9. 9 TL=150:RS=9:SUB=1:LL=5
  10. 10 DN$=""
  11. 11 RX$=""
  12. 20 DIM ML$(TL,RS)
  13. 30 POKE53281,15:LN=24:RTN$=CHR$(13)
  14. 40 GOSUB10700:REM HEADINGS
  15. 120 IFN$<>"N"THENGOSUB9000
  16. 149 REM##UNDERSCORES
  17. 150 GOSUB8000
  18. 159 REM##PRINT ADDR
  19. 160 GOSUB8100
  20. 179 REM##TEST INPUT
  21. 180 GETN$:IFN$=""THEN180
  22. 190 IFN$<>"E"THEN200
  23. 192 GOSUB8200:GOTO149
  24. 200 IFN$<>"P"THEN210
  25. 205 OPEN4,4:GOSUB8300:CLOSE4
  26. 210 IFN$<>"H"THEN213
  27. 211 SUB=1:GOTO149
  28. 213 IFN$<>"L" THEN 220
  29. 214 GOSUB10300:GOTO149
  30. 220 IFN$<>"N"THEN260
  31. 221 SUB=SUB+1:IFSUB<TLTHEN225:SUB=LN:MSG$="TABLE FULL-SAVE"
  32. 222 SUB=LN:MSG$="TABLEFULL-SAVE":GOTO149
  33. 225 GOTO149
  34. 260 IFN$<>"B"THEN270
  35. 265 SUB=SUB-1:IFSUB<1THENSUB=1
  36. 266 GOTO149
  37. 270 IF N$<>"K" THEN 280
  38. 272 GOSUB9400:GOTO149
  39. 280 IFN$<>"S"THEN290
  40. 285 GOSUB8500:GOTO149
  41. 290 IF N$<>"Q"THEN300
  42. 293 PRINT"[147]QUITTING NOW":END
  43. 300 IFN$<>"U"THEN400
  44. 320 GOSUB9100:GOTO149
  45. 400 IFN$<>"D"THEN450
  46. 420 GOSUB7000:GOTO149
  47. 450 IFN$<>"A"THEN470
  48. 455 GOSUB7500
  49. 469 REM##TEST FOR CONTINUE OF SEARCH
  50. 470 IFS1<>1THEN500
  51. 472 IFN$="C"THENYX=SRB+1:GOSUB9743
  52. 500 GOTO149
  53. 7000 REM ###DELETE ENTRY
  54. 7020 MSG$="DELETE  YOU SURE ??Y"
  55. 7030 GOSUB8100:MSG$="D E L E T I N G      ":DUB=SUB
  56. 7040 GETDE$:IFDE$=""THEN7040
  57. 7045 IFDE$<>"Y"THEN7099
  58. 7047 GOSUB8100:MSG$=""
  59. 7050 FORX=1TORS:ML$(DUB,X)=ML$(DUB+1,X):NEXT
  60. 7060 IFDUB=RCTHENRC=RC-1:GOTO7099
  61. 7065 DUB=DUB+1:GOTO7050
  62. 7099 MSG$="":RETURN
  63. 7340 PRINT"[152]ENTER COMMAND SHOWN ON SCREEN[151]"
  64. 7500 SUB=RC+1
  65. 7520 IF SUB< TL THEN 7550
  66. 7540 MSG$="NO ROOM FOR ADD SAVE ":GOTO149
  67. 7550 GOSUB8000:GOSUB8100:GOSUB8200:RETURN
  68. 8000 REM###PRINT UNDERSCORES
  69. 8005 PRINT"[147]"
  70. 8010 FORLP=1TO5
  71. 8020 PRINT""LP"[164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164]"
  72. 8030 NEXTLP
  73. 8040 PRINT"     PHONE  [164][164][164][164][164][164][164][164][164][164][164][164]  LBL GRP  [164]"
  74. 8050 PRINT"     XMAS LIST  [164]       XMAS LBL  [164]"
  75. 8100 REM###DSPLY ADDRESS
  76. 8120 PRINT""
  77. 8130 FORLP=1TOLL
  78. 8140 PRINT""ML$(SUB,LP)
  79. 8142 POKE198,0
  80. 8143 NEXTLP
  81. 8144 LP=LP-1
  82. 8150 PRINT"";LEFT$(DN$,12);LEFT$(RX$,12);ML$(SUB,LP+1)
  83. 8155 PRINT"[145]";LEFT$(RX$,35);ML$(SUB,LP+2)
  84. 8160 PRINT"";LEFT$(RX$,16);ML$(SUB,LP+3)
  85. 8165 PRINT"[145]";LEFT$(RX$,34);ML$(SUB,LP+4)
  86. 8193 GOSUB10000
  87. 8194 RETURN
  88. 8200 REM###READ FROM SCREEN
  89. 8210 PRINT""
  90. 8220 FORLP=1TO5
  91. 8225 W1$=""
  92. 8230 PRINT
  93. 8231 INPUT"";LIN$
  94. 8235 FORX=1TO30
  95. 8237 IF MID$(LIN$,X,1)<>"[164]"THEN W1$=W1$+MID$(LIN$,X,1)
  96. 8238 IF MID$(LIN$,X,2)="[164][164]" THEN8250
  97. 8240 NEXTX
  98. 8250 ML$(SUB,LP)=W1$
  99. 8255 LIN$=W1$
  100. 8260 NEXTLP
  101. 8262 IF N$<>"E" THEN RC=RC+1
  102. 8264 SL=12
  103. 8265 INPUT"";FX$:GOSUB10100:ML$(SUB,6)=FR$
  104. 8267 SL=1
  105. 8268 PRINT"[145]";LEFT$(RX$,33);:INPUTFX$:GOSUB10100:ML$(SUB,7)=FR$
  106. 8272 PRINT"";LEFT$(RX$,14);:INPUTFX$:GOSUB10100: ML$(SUB,8)=FR$
  107. 8278 PRINT"[145]";LEFT$(RX$,32);:INPUTFX$:GOSUB10100:ML$(SUB,9)=FR$
  108. 8295 RETURN
  109. 8300 REM###PRINTENTRY
  110. 8330 FORLP=1TOLL
  111. 8335 IF LEFT$(ML$(SUB,LP),1)="_"THENPRINT#4,"[160]":GOTO8345
  112. 8340 PRINT#4,ML$(SUB,LP)
  113. 8345 NEXTLP
  114. 8350 PRINT#4,""
  115. 8360 RETURN
  116. 8500 REM##PUT TO DISK
  117. 8508 OPEN15,8,15
  118. 8510 OPEN2,8,2,"@0:MAILLIST,S,W":GOSUB9600
  119. 8515 PRINT#2,RC
  120. 8520 FORPT=1TORC
  121. 8525 FORX=1TORS
  122. 8527 IFML$(PT,X)="" THEN PRINT#2,"\":GOTO8535
  123. 8530 PRINT#2,ML$(PT,X)
  124. 8535 NEXTX
  125. 8540 NEXTPT
  126. 8550 CLOSE2:GOSUB9600:CLOSE15:RETURN
  127. 9000 REM##GET FROM DISK
  128. 9005 OPEN15,8,15
  129. 9006 IF N$="B"THENOPEN3,8,3,"MAIL.FILE.BK,S,R":GOSUB9600:GOTO9013
  130. 9010 OPEN3,8,3,"MAILLIST,S,R":GOSUB9600
  131. 9013 INPUT#3,RC
  132. 9020 FORPT=1TORC
  133. 9024 FORX=1TORS
  134. 9030 INPUT#3,ML$(PT,X):GOSUB9600
  135. 9033 IF LEFT$(ML$(PT,X),1)="\" THEN ML$(PT,X)=""
  136. 9036 NEXTX
  137. 9040 NEXTPT
  138. 9050 CLOSE3:CLOSE15:RETURN
  139. 9100 REM##PERFORM LISTAND FIND
  140. 9110 LSB=SUB
  141. 9120 PRINT"[147]PRINTER OPTIONS"
  142. 9123 PRINT"TO CREATE A DIRECTORY":PRINT"PF5[146][151] LIST ALL ENTRIES
  143. 9124 [153]"PF3WAITPOKE LIST FROM THIS POINT"
  144. 9125 [153]"ENTER PF1WAITPOKE TO DO SEARCH"
  145. 9128 [153]"ENTER PF2POKEWAIT FOR XMAS CARD COUNT"
  146. 9130 [153]"ENTER PF4WAITPOKE TO RESET XMAS CARDS":[153]"SENT INDICATORS"
  147. 9135 [153]"ENTER PF7WAITPOKE TO RETURN"
  148. 9140 [161]LI$:[139]LI$[178]""[167]9140
  149. 9145 [139] LI$[178][199](137) [167] 9200
  150. 9147 [139] LI$[178][199](138) [167] 9300
  151. 9150 [139]LI$[178][199](136)[167]9199
  152. 9152 [139]LI$[178][199](135)[167]LSB[178]1:[137]9160
  153. 9153 [139]LI$[178][199](133)[167][141]9700:[137]9199
  154. 9154 [139]LI$[178][199](134)[167]9160
  155. 9156 [137]9140
  156. 9160 [159]4,4
  157. 9163 [139]LSB[177](RC)[167]9198
  158. 9164 [139]ML$(LSB,1)[178]""[167]9183
  159. 9165 [152]4,[199](15)[199](145):[152]4,""
  160. 9168 [152]4,[199](16)"10"ML$(LSB,1)
  161. 9172 [129]LP[178]2[164]6
  162. 9173 [139] ML$(LSB,LP)[178]"" [167] 9178
  163. 9176 [152]4,[199](16)"15"ML$(LSB,LP)
  164. 9178 [130]LP
  165. 9180 [152]4,[199](16)"15XMAS  ";ML$(LSB,8)[199](16)"28MISC LB  ";ML$(LSB,7)
  166. 9181 [161]K$:[139]K$[178]"C"[167][152]4:[160]4:[142]
  167. 9183 LSB[178]LSB[170]1
  168. 9185 [139]LSB[179]RC[167]9164
  169. 9198 [152]4,[199](15)[199](10):[160]4,4
  170. 9199 [142]
  171. 9200 CC[178]0
  172. 9202 [129] X[178]1[164]RC
  173. 9210 [139] ML$(X,8)[178]"Y" [167] CC[178]CC[170]1
  174. 9220 [130]X
  175. 9230 [153]"";[200](DN$,22);"CHRISTMAS CARDS FOUNDPOKEWAIT ";CC
  176. 9240 [153]"PRINT#ENTER A COMMAND SHOWN ON SCREENPOKE"
  177. 9250 [137]9140
  178. 9300 [129]X[178]1[164]RC
  179. 9310 [139] ML$(X,8)[178]"Y"[167]ML$(X,9)[178]"N"
  180. 9320 [130]X
  181. 9330 [153]"";[200](DN$,22);"CHRISTMAS LABELS RESETPOKEWAIT        "
  182. 9340 [153]"PRINT#ENTER COMMAND SHOWN ON SCREENPOKE"
  183. 9350 [137]9140
  184. 9400 [153]"LOADBACK UP MAIL LIST FILE TO SEPARATE":[153]"DISK FILE"
  185. 9410 [153]"BACKING UP WILL CAUSE PROGRAM TO"
  186. 9420 [153]"QUIT AFTER IT IS COMPLETED"
  187. 9430 [153]"IS THIS WHAT YOU WANT"
  188. 9440 [161]X$:[139] X$[179][177]"Y"[175]X$[179][177]"N" [167]9440
  189. 9450 [139] X$[178]"N" [167] [142]
  190. 9460 [153]"LOAD BACKUP DISK AND HIT ANY KEY"
  191. 9465 [161] X$:[139] X$[178]"" [167] 9465
  192. 9470 [159] 15,8,15,"I":[141]9600:[160]15
  193. 9475 [159] 15,8,15:[141]9600
  194. 9480 [159] 6,8,6,"@0:MAIL.FILE.BK,S,W"
  195. 9485 [152]6,RC
  196. 9490 [129] X[178]1[164]RC
  197. 9495 [129]Y[178]1[164]RS
  198. 9496 [139]ML$(X,Y)[178]"" [167] [152]6,"\":[137]9500
  199. 9498 [152]6,ML$(X,Y):[141]9600
  200. 9500 [130]Y:[130]X
  201. 9510 [160]6:[160]15
  202. 9520 [153]"BACKUP COMPLETED"
  203. 9525 [153]"YOUR BACKUP DISK IS STILL IS IN THE ":[153]"         DRIVE"
  204. 9530 [153]"JOB ENDS":[128]
  205. 9600 [132]15,EN,EM$
  206. 9610 [139] EN[178]0 [167] [142]
  207. 9620 [153]"DISK ERROR":[153]EN,EM$:[128]
  208. 9700 [143]##SEARCH FOR STRING
  209. 9705 S1[178]0:SR$[178]""
  210. 9710 [153]"LOADTYPE IN SEARCH STRING"
  211. 9713 [133]SR$
  212. 9715 [139]SR$[178]""[167]9199
  213. 9717 [153]"PRINT#SEARCH POKENPRINT#AME ONLY OR POKEAPRINT#LL ADDR":[133]W3$
  214. 9718 [139] W3$[178]"N"[167]L7[178]1:[137]9720
  215. 9719 L7[178]6
  216. 9720 [153]RTN$"SEARCHING FOR"RTN$""SR$"WAITSTOP"
  217. 9725 [153]RTN$"TYPE IN CWAITSTOP TO CANCEL   DURING SEARCH"
  218. 9730 SRB[178]1:YX[178]1
  219. 9741 L[178][195](SR$)
  220. 9743 [129]SRB[178]YX[164]RC
  221. 9744 [153]"ENTRIES SEARCHED"SRB
  222. 9746 [129]X[178]1[164]L7
  223. 9748 LT[178][195](ML$(SRB,X))
  224. 9749 L5[178]LT[171]L[170]1
  225. 9750 [129]CN[178]1[164]L5
  226. 9755 [139][202](ML$(SRB,X),CN,L)[178]SR$[167]9790
  227. 9756 [161]CN$:[139]CN$[179][177]"C"[167]9758
  228. 9757 MSG$[178]"SEARCH CANCELLED":[142]
  229. 9758 [130]CN:[130]X:[130]SRB
  230. 9765 MSG$[178]"STRING NOT FOUND":[142]
  231. 9790 SUB[178]SRB:S1[178]1:MSG$[178]"C  TO CONTINUE SEARCH":[142]
  232. 10000 [153]"";[200](DN$,17)
  233. 10010 [153]"    PRINT#ENTRY NUMBERWAITPOKE"SUB"STOP"
  234. 10020 [153]" POKEEPRINT#DIT POKEPPRINT#RINT POKENPRINT#EXT POKEBPRINT#ACK POKEHPRINT#OME PRINT#BPOKEKPRINT#UP"       "
  235. 10030 PRINT" [151]S[152]AVE [151]U[152]TILITY [151]D[152]EL [151]A[152]DD[144]";" [151]L[152]ABEL [151]Q[152]UIT[151]"
  236. 10040 IFFR=0THEN10060
  237. 10050 PRINT""LEFT$(MSG$,14)FR"[146][144]":GOTO10070
  238. 10060 PRINT""MSG$"[146][144]"
  239. 10070 MSG$="":FR=0:RETURN
  240. 10100 FR$=""
  241. 10105 FORX=1TOSL
  242. 10110 IF MID$(FX$,X,1)<>"[164]"THENFR$=FR$+MID$(FX$,X,1)
  243. 10120 NEXT
  244. 10130 FX$=""
  245. 10140 RETURN
  246. 10300 PRINT"[147]LABEL PROCESSING"
  247. 10310 PRINT"[151]C[152]HRISTMAS LABELS"
  248. 10320 PRINT"[151]B[152]USINESS LABELS"
  249. 10325 PRINT"[151]M[152]ULTIPLE COPIES 1 LABEL"
  250. 10330 PRINT"[151]N[152]O LABELS[144]"
  251. 10335 PRINT"ENTER C TO STOP LABEL PRINTING[144]"
  252. 10340 GETL$:IFL$<>"C"ANDL$<>"B"ANDL$<>"N"ANDL$<>"M"THEN10340
  253. 10350 IF L$="N" THEN RETURN
  254. 10355 OPEN4,4:SX=SUB
  255. 10357 IFL$="M" THEN 10500
  256. 10360 IF L$="C" THEN 10460
  257. 10370 INPUT"[147]BUSINESS LABEL GROUP";BG$
  258. 10380 PRINT"HIT ANY KEY WHEN LABELS ALIGNED"
  259. 10390 GETK$:IFK$="" THEN 10390
  260. 10400 FORSUB=1TOTL
  261. 10405 PRINT"SEARCHING";SUB
  262. 10410 IF ML$(SUB,7)=BG$ THEN GOSUB8300
  263. 10415 GETK$:IFK$="C"THENPRINT#4:CLOSE4:RETURN
  264. 10420 NEXTSUB:CLOSE4:SUB=SX:RETURN
  265. 10460 PRINT"[147]CHRISTMAS LABELS"
  266. 10470 FORSUB=1TOTL
  267. 10475 GETK$:IFK$="C"THENPRINT#4:CLOSE4:SUB=SX:RETURN
  268. 10480 IF ML$(SUB,8)="Y"ANDML$(SUB,9)<>"Y"THENGOSUB8300:ML$(SUB,9)="Y"
  269. 10490 NEXTSUB:CLOSE4:SUB=SX:RETURN
  270. 10500 PRINT"[147]ARE YOU POSITIONED AT DESIRED ADDRESS"
  271. 10510 GET K$:IFK$="" THEN 10510
  272. 10520 IF K$="N" THEN RETURN
  273. 10530 INPUT"HOW MANY LABELS";NL
  274. 10540 SZ=SUB:FORX6=1TONL
  275. 10550 GETK$:IFK$="C"THENPRINT#4:CLOSE4:SUB=SX:RETURN
  276. 10560 GOSUB8300
  277. 10570 NEXTX6:SUB=SX:CLOSE4:RETURN
  278. 10700 PRINT"[147]";LEFT$(RX$,9);"M A I L  L I S T  6 4[144]"
  279. 10710 PRINTLEFT$(RX$,16);"B Y"
  280. 10720 PRINT"[144]";SPC(10);"DAVE & AL JOHNSON"
  281. 10730 PRINT"THIS IS A VERSATILE MAIL LIST"
  282. 10740 PRINT"PROGRAM.  IT WORKS ONLY WITH DISK"
  283. 10750 PRINT"IT PRINTS BUSINESS AND CHRISTMAS"
  284. 10760 PRINT"LABELS"
  285. 10770 PRINT"ENTER N[146] IF THIS IS FOR A NEW"
  286. 10780 PRINT"FILE.  ENTER 'B' TO LOAD BACKUP FILE"
  287. 10785 PRINT"ENTER ANY OTHER KEY IF THE MAIN FILE"
  288. 10790 PRINT"ALREADY EXISTS"
  289. 10800 GETN$:IFN$=""THEN10800
  290. 10810 RETURN
  291. 11000 REM ***************************
  292. 11010 REM * USER NOTES ON MAIL.64
  293. 11020 REM * THIS PROGRAM WAS ORIGINALLY
  294. 11030 REM * WRITTEN FOR A VIC20 BY D.
  295. 11040 REM * JOHNSON.  WE UPGRADED IT TO
  296. 11050 REM * BETTER RUN ON THE C64.
  297. 11060 REM *
  298. 11070 REM * THE MENU IS RELATIVELY EASY
  299. 11080 REM * TO FOLLOW.  YOU HAVE A 5
  300. 11090 REM * LINE ADDRESS TO ENTER. TO
  301. 11100 REM * INDENT INFO (ZIP CODE) USE
  302. 11110 REM * SHIFTED SPACES.  TO KEEP
  303. 11120 REM * ADDRESS INFO FROM PRINTING
  304. 11130 REM * ON LABELS, PUT A LEFT ARROW
  305. 11140 REM * IN THE FIRST POSITION.
  306. 11150 REM * THERE ARE TWO LABEL FIELDS.
  307. 11160 REM * THE FIRST IS INTENDED TO BE
  308. 11170 REM * BE USED FOR CHRISTMAS CARD
  309. 11180 REM * LABELS.  PUT IN A 'Y' TO
  310. 11190 REM * HAVE THE ADDRESS PRINTED
  311. 11200 REM * DURING THE CHRISTMAS LABEL
  312. 11210 REM * RUN.  THE OTHER FIELD IS
  313. 11220 REM * FOR MISC. LABELS.  YOU CAN
  314. 11230 REM * PUT AN 'A' IN IT AND THEN
  315. 11240 REM * PRINT LABELS FOR ALL
  316. 11250 REM * ADDRESSES WITH AN 'A'.
  317. 11260 REM *
  318. 11270 REM * PLAY AROUND WITH THE OTHER
  319. 11280 REM * OPTIONS.  THEY'RE PRETTY
  320. 11290 REM * EASY TO FOLLOW.
  321. 11300 REM *
  322. 11310 REM * IF YOU LIKE THE PROGRAM OR
  323. 11320 REM * MAKE A GOOD MODIFICATION,
  324. 11330 REM * I WOULD LIKE TO HEAR FROM
  325. 11340 REM * YOU.  PLEASE DROP ME A CARD
  326. 11350 REM * AT THE ADDRESS AT THE FIRST
  327. 11360 REM * PART OF THE PROGRAM.
  328. 11370 REM *
  329. 11380 REM * -- DELETE THESE NOTES AFTER
  330. 11390 REM *    READING OR LISTING THEM.
  331. 11395 REM *              AL JOHNSON
  332. 11400 REM ****************************
  333.